perm filename EUCLID.OLD[GEM,HE] blob
sn#100705 filedate 1974-05-03 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00011 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE EUCLID - EUCLIDEAN ROUTINES - BRUCE G. BAUMGART - JULY 1972.
C00005 00003 SUBR(TRANSLATE,FRMOBJ,DX,DY,DZ) OBJECT TRANSLATION WRT FRAME.
C00009 00004 SUBR(APTRAN,OBJECT,TRAN) APPLY EUCLIDEAN TRANSFORMATION TO THE OBJECT.
C00013 00005 SUBN(ROTOR)
C00015 00006 SUBR(INTRAN,TRAN) INVERT A TRANSFORMATION.
C00017 00007 SUBR(MKROT1,PAN,TILT,SWING)
C00022 00008 SUBR(NORM,FRAME) NORMALIZE A FRAME MATRIX.
C00033 00009 SUBR(ORTHO2,QFRAME)
C00036 00010 SUBR(ANGL3V,VERT1,VERT2,VERT3) ANGLE TRI-VERTEX.
C00039 00011 SUBR(DISTAN,V1,V2) DISTANCE BETWEEN TWO VERTICES.
C00049 ENDMK
C⊗;
TITLE EUCLID - EUCLIDEAN ROUTINES - BRUCE G. BAUMGART - JULY 1972.
EXTERN ECW,ECCW,OTHER
EXTERN BGET,FCW,FCCW,VCW,VCCW
EXTERN MKCOPY,MKFRAME,KLNODE
EXTERN SIN,COS,SQRT,ATAN,ATAN2,ASIN,ACOS,LOG,HALFPI,PI,TWOPI
COMMENT ⊗----------------------------------------------------------------------
EUCLIDEAN TRANSFORMATIONS
TRANS ← TRANSL(XWD(FRAME,BODY),DX,DY,DZ);
TRANS ← ROTATE(XWD(FRAME,BODY),DX,DY,DZ);
TRANS ← SHRINK(XWD(FRAME,BODY),DX,DY,DZ);
TRANS ← APTRAN(ENTITY,TRANS);
{ROTOR}
TRANS ← INTRAN(TRAN);
FRAME MAKERS
TRANS ← MKROT1(PAN,TILT,SWING); MAKE FROM EULER ANGLES.
TRANS ← MKFFRM(FACE); MAKE FACE FRAME.
TRANS ← MKQFRM(WX,WY,WZ); MAKE FROM ROTATION VECTOR.
FRAME ORTHONORMALIZATION.
NORM(FRAME) ;NORMALIZATION TO UNIT VECTORS.
ORTHO1(FRAME) ;ORTHOGONALIZE BY WORST CASE.
ORTHO2(FRAME) ;ORTHOGONALIZE BY K ← (I CROSS J), J ← (K CROSS I).
GEOMETRIC MEASURE ROUTINES.
DETERM(FRAME)
ANGL3V(V1,V2,V3)
DISTANCE(ENTITY,ENTITY);
------------------------------------------------------------------------------⊗
SUBR(TRANSLATE,FRMOBJ,DX,DY,DZ) ;OBJECT TRANSLATION WRT FRAME.
COMMENT .-----------------------------------------------------------.
CALL(MKFRAME)
HRLZI DX↔HRRI XWC(1)↔BLT ZWC(1) ;DELTA'S OF TRANSLATION.
↑QTRAN: DAC 1,TMP1 ;SECOND ENTRY.
MOVM 2,FRMOBJ↔CDR 2,2↔DAC 2,OBJECT
HLRE 1,FRMOBJ↔SKIPGE 1↔GO[
SETZ 1,↔JUMPE 2,.+1 ;JUMP WHEN NO OBJECT.
CALL(BGET,OBJECT) ;GET BODY OF THE OBJECT.
FRAME 1,1↔GO .+1] ;GET FRAME OF THE BODY.
DAC 1,REFRAM ;FRAME OF REFERENCE.
LAC 1,TMP1↔SKIPN REFRAM↔GO L1
L0: SETQ(TMP2,{MKCOPY,REFRAM})
CALL(INTRAN,TMP2)
CALL(APTRAN,TMP2,TMP1)
CALL(APTRAN,TMP2,REFRAM)
CALL(KLNODE,TMP1)
LAC 1,TMP2↔DAC 1,TMP1 ;TMP1 ← TMP2.
L1: SKIPN OBJECT↔POP4J ;RETURN TRANSFORMATION.
CALL(APTRAN,OBJECT,TMP1)
CALL(KLNODE,TMP1)
LAC 1,OBJECT↔POP4J ;RETURN THE OBJECT.
DECLARE{TMP1,TMP2,REFRAM,OBJECT}
ENDR TRANSLATE;3/18/73(BGB)------------------------------------------
SUBR(ROTATE,FRMOBJ,WX,WY,WZ) ;OBJECT ROTATION WRT FRAME.
COMMENT .-----------------------------------------------------------.
;COMPONENTS OF ROTATION VECTOR.
SKIPE 1,WX↔FMPR 1,1↔DAC 1,4
SKIPE 2,WY↔FMPR 2,2↔DAC 2,5
SKIPE 3,WZ↔FMPR 3,3
FADR 1,2↔FADR 1,3↔JUMPE 1,POP1J.
SETQ(W,{SQRT↑,1})
;ROTATION AXIS FRAME OF REFERENCE.
SETQ(TMP1,{MKFRAME})↔DAC 1,7
LAC 1,WX↔FDVR 1,W↔DAC 1,IX(7)
LAC 2,WY↔FDVR 2,W↔DAC 2,IY(7)
LAC 3,WZ↔FDVR 3,W↔DAC 3,IZ(7)
MOVM 2↔CAMG [0.99]↔GO .+3 ;W ALMOST COLINEAR WITH J VECTOR.
SETZM JY(7)↔DAC 2,JX(7) ;CHANGE J VECTOR.
CALL(ORTHO2,TMP1)↔CALL(NORM,TMP1)
;ROTATION ABOUT I UNIT VECTOR.
SETQ(TMP2,{MKFRAME})
CALL(COS,W)↔LAC 2,TMP2↔DAC 1,JY(2)↔DAC 1,KZ(2)
CALL(SIN,W)↔LAC 2,TMP2↔DAC 1,JZ(2)↔MOVNM 1,KY(2)
CALL(APTRAN,TMP2,TMP1)
LAC 1,TMP1 ;TRANSPOSITION.
LAC IY(1)↔EXCH JX(1)↔DAC IY(1)
LAC IZ(1)↔EXCH KX(1)↔DAC IZ(1)
LAC JZ(1)↔EXCH KY(1)↔DAC JZ(1)
CALL(APTRAN,TMP1,TMP2)↔CALL(KLNODE,TMP2)
LAC 1,TMP1↔GO QTRAN
DECLARE{W,TMP1,TMP2,TMP3,REFRAM,OBJECT}
ENDR ROTATE;3/18/73(BGB)---------------------------------------------
SUBR(SHRINK,FRMOBJ,KKX,KKY,KKZ) ;DILATION-REFLECTION WRT FRAME.
COMMENT .-----------------------------------------------------------.
CALL(MKFRAME)
SKIPN 2,KKX↔MOVSI 2,(1.0)↔DAC 2,IX(1)
SKIPN 2,KKY↔MOVSI 2,(1.0)↔DAC 2,JY(1)
SKIPN 2,KKZ↔MOVSI 2,(1.0)↔DAC 2,KZ(1)↔GO QTRAN
ENDR SHRINK;3/18/73(BGB)---------------------------------------------
SUBR(APTRAN,OBJECT,TRAN); APPLY EUCLIDEAN TRANSFORMATION TO THE OBJECT.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,F,E,V,X,Y,Z,TRN,N,OBJ,E0}
SKIPE OBJ,OBJECT↔SKIPN TRN,TRAN↔POP2J ;IGNORE ZERO ARGS.
MOVM 1,(OBJ)↔JUMPE 1,LROTA ;GET TYPE OF OBJECT.
TLNE 1,(1B9)↔GO LROTA ;FRAME.
ANDI 1,17↔GO @.+1(1) ;DISPATCH ON TYPE OF OBJECT.
POP2J.↔POP2J.↔POP2J.↔CROTA ;FRAME EMPTY UNIVERSE SUN
CROTA↔POP2J.↔POP2J.↔POP2J. ;CAMERA WORLD WINDOW IMAGE
POP2J.↔POP2J.↔POP2J.↔POP2J. ;TEXT XNODE YNODE ZNODE
BROTA↔FROTA↔EROTA↔VROTA ;BODY FACE EDGE VERTEX
;....................................................................
LROTA: LAC V,OBJ↔SETZM TMP2#↔GO .+3 ;FRAME CASE.
CROTA: FRAME V,OBJ↔DAC V,TMP2# ;CAMERA & SUN CASE.
CALL(ROTOR)
PUSH P,XWC(TRN)↔PUSH P,YWC(TRN)↔PUSH P,ZWC(TRN)
SETZM XWC(TRN)↔SETZM YWC(TRN)↔SETZM ZWC(TRN)
ADDI V,3↔CALL(ROTOR)
ADDI V,3↔CALL(ROTOR)
ADDI V,3↔CALL(ROTOR)
POP P,ZWC(TRN)↔POP P,YWC(TRN)↔POP P,XWC(TRN)
SKIPN TMP2↔POP2J
CALL(NORM,TMP2#)
CALL(ORTHO1,TMP2#)↔POP2J
;....................................................................
BROTA: LAC B,OBJ ;BODY ROTATION.
TESTZ B,BDVBIT↔GO L2 ;DON'T MOVE VERTICES.
LAC V,B ;1ST VERTEX.
L1: PVT V,V
CAMN V,OBJ↔GO L2 ;SKIP WHEN VERTEX.
CALL(ROTOR)↔GO L1 ;ROTATE VERTEX.
L2: LAC B,OBJ
TESTZ B,BDLBIT↔GO L3 ;DON'T MOVE FRAME.
FRAME V,B↔SKIPN V↔GO L3
DAC V,TMP#↔PUSH P,B
CALL(APTRAN,V,TRN) ;BODY'S FRAME.
CALL(NORM,TMP#)
CALL(ORTHO1,TMP#)↔POP P,B
;PARTS OF THIS BODY.
L3: TESTZ B,BDPBIT↔POP2J ;DON'T MOVE PARTS.
SON N,B↔JUMPE N,POP2J.
L4: CALL(APTRAN,N,N,TRN)
POP P,N↔LAC B,OBJECT
BRO N,N↔SON 0,B
CAME 0,N↔GO L4↔POP2J
;....................................................................
FROTA: LAC F,OBJ↔NCNT N,F↔MOVMS N ;FACE ROTATION.
PED E,F↔DAC E,E0↔JUMPE E0,[ ;VERTEX FACE.
PFACE B,F↔PVT V,B↔CALL(ROTOR)↔POP2J]
PCW 0,E↔SKIPN N↔CAMN 0,E↔GO[ ;WIRE OR SHELL FACE.
SETQ(V,{VCW,E,F})↔CALL(ROTOR)↔GO .+1]
L5: SETQ(V,{VCCW,E,F})
CALL(ROTOR)↔CALL(ECCW,E,F)
CAMN 1,E↔POP2J ;END OF WIRE FACE.
LAC E,1↔CAMN E,E0↔POP2J ;END OF NORMAL FACE.
SOJN N,L5↔POP2J ;END OF SHELL FACE.
;....................................................................
EROTA: LAC E,OBJ ;EDGE ROTATION
PVT V,E↔CALL(ROTOR)
NVT V,E↔CALL(ROTOR)↔POP2J
VROTA: LAC V,OBJ↔CALL(ROTOR)↔POP2J ;VERTEX ROTATION.
ENDR APTRAN;1/14/73(BGB)------------------------------------------
SUBN(ROTOR)
COMMENT ⊗------------------------------------------------------------
; APTRAN's inner most subroutine.
; Expects arguments in V and Q. Clobbers 1,2,X,Y,Z.
;
; X ← XWC(V);
; Y ← YWC(V);
; Z ← ZWC(V);
;
; XWC(V) ← X*IX(Q) + Y*JX(Q) + Z*KX(Q) + XWC(Q);
; YWC(V) ← X*IY(Q) + Y*JY(Q) + Z*KZ(Q) + YWC(Q);
; ZWC(V) ← X*IZ(Q) + Y*JZ(Q) + Z*KZ(Q) + ZWC(Q);
⊗
ACCUMULATORS{B,F,E,V,X,Y,Z,Q}
LAC X,XWC(V)↔LAC Y,YWC(V)↔LAC Z,ZWC(V)
LAC 1,IX(Q)↔CAMN 1,[1.0]↔SKIPA 1,X↔FMPR 1,X
SKIPE 2,JX(Q)↔GO[FMPR 2,Y↔FADR 1,2↔GO .+1]
SKIPE 2,KX(Q)↔GO[FMPR 2,Z↔FADR 1,2↔GO .+1]
SKIPE 2,XWC(Q)↔FADR 1,2↔DAC 1,XWC(V)
LAC 1,JY(Q)↔CAMN 1,[1.0]↔SKIPA 1,Y↔FMPR 1,Y
SKIPE 2,IY(Q)↔GO[FMPR 2,X↔FADR 1,2↔GO .+1]
SKIPE 2,KY(Q)↔GO[FMPR 2,Z↔FADR 1,2↔GO .+1]
SKIPE 2,YWC(Q)↔FADR 1,2↔DAC 1,YWC(V)
LAC 1,KZ(Q)↔CAMN 1,[1.0]↔SKIPA 1,Z↔FMPR 1,Z
SKIPE 2,JZ(Q)↔GO[FMPR 2,Y↔FADR 1,2↔GO .+1]
SKIPE 2,IZ(Q)↔GO[FMPR 2,X↔FADR 1,2↔GO .+1]
SKIPE 2,ZWC(Q)↔FADR 1,2↔DAC 1,ZWC(V)
POP0J
ENDR ROTOR;3/18/73(BGB)-------------------------------------------
SUBR(INTRAN,TRAN) ;INVERT A TRANSFORMATION.
COMMENT .-----------------------------------------------------------.
Q ←← 6
LAC 2,TRAN
MOVSI XWC(2)↔HRRI XWC+Q↔BLT KZ+Q
;XWC' ← -(XWC*IX + YWC*IY + ZWC*IZ);
LAC 1,XWC+Q↔FMPR 1,IX+Q
LAC YWC+Q↔FMPR IY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR IZ+Q↔FADR 1,0
MOVNM 1,XWC(2)
;YWC' ← -(XWC*JX + YWC*JY + ZWC*JZ);
LAC 1,XWC+Q↔FMPR 1,JX+Q
LAC YWC+Q↔FMPR JY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR JZ+Q↔FADR 1,0
MOVNM 1,YWC(2)
;ZWC' ← -(XWC*KX + YWC*KY + ZWC*KZ);
LAC 1,XWC+Q↔FMPR 1,KX+Q
LAC YWC+Q↔FMPR KY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR KZ+Q↔FADR 1,0
MOVNM 1,ZWC(2)
;TRANSPOSE ROTATION MATRIX.
DAC JX+Q,IY(2)
DAC KX+Q,IZ(2)
DAC IY+Q,JX(2)
DAC KY+Q,JZ(2)
DAC IZ+Q,KX(2)
DAC JZ+Q,KY(2)
LAC 1,2
POP1J
ENDR INTRAN;3/18/73(BGB)---------------------------------------------
SUBR(MKROT1,PAN,TILT,SWING)
COMMENT .-----------------------------------------------------------.
SETQ(CP,{COS,PAN})↔ SETQ(SP,{SIN,PAN})
SETQ(CT,{COS,TILT})↔ SETQ(ST,{SIN,TILT})
SETQ(CS,{COS,SWING})↔ SETQ(SS,{SIN,SWING})
CALL(MKFRAME)
LAC SP↔FMP CT↔FMP SS↔DAC 2↔LAC CP↔FMP CS↔FSB 2↔DAC IX(1)
LAC CP↔FMP CT↔FMP SS↔DAC 2↔LAC SP↔FMP CS↔FAD 2↔DAC IY(1)
LAC ST↔FMP SS↔DAC IZ(1)
LAC SP↔FMP CT↔FMP CS↔DAC 2↔LAC CP↔FMP SS↔FAD 2↔MOVNM JX(1)
LAC CP↔FMP CT↔FMP CS↔DAC 2↔MOVN SP↔FMP SS↔FAD 2↔DAC JY(1)
LAC ST↔FMP CS↔DAC JZ(1)
LAC SP↔FMP ST↔DAC KX(1)
LAC CP↔FMP ST↔MOVNM KY(1)
LAC CT↔DAC KZ(1)↔POP3J
DECLARE{CP,CT,CS,SP,ST,SS}
ENDR MKROT1;10/30/73(BGB)--------------------------------------------
SUBR(MKFFRM,FACE) ;MAKE FACE FRAME.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,E,E0,V,X,Y,Z,N}
LAC F,FACE↔PED E,F↔DAC E,E0
SETZB X,Y↔SETZB Z,N
L1: SETQ(V,{VCCW,E,F})↔SETQ(E,{ECCW,E,F})
FADR X,XWC(V)↔FADR Y,YWC(V)↔FADR Z,ZWC(V)
CAME E,E0↔AOJA N,L1↔AOS N
;CENTER OF FACE BECOMES ORIGIN.
FLOAT N,↔FDVR X,N↔FDVR Y,N↔FDVR Z,N
SETQ(F,{MKFRAME})↔DAC F,FRM#
DAC X,XWC(F)↔DAC Y,YWC(F)↔DAC Z,ZWC(F)
;FIRST TWO VECTORS.
SETQ(V,{VCW,E0,FACE})
LAC XWC(V)↔FSBR X↔DAC IX(F)
LAC YWC(V)↔FSBR Y↔DAC IY(F)
LAC ZWC(V)↔FSBR Z↔DAC IZ(F)
SETQ(V,{VCCW,E0,FACE})
LAC XWC(V)↔FSBR X↔DAC JX(F)
LAC YWC(V)↔FSBR Y↔DAC JY(F)
LAC ZWC(V)↔FSBR Z↔DAC JZ(F)
CALL(ORTHO2,FRM)
CALL(NORM,FRM)
CALL(ORTHO1,FRM)
LAC 1,FRM↔POP1J
ENDR MKFFRM;2/19/74(BGB)---------------------------------------------
SUBR(MKQFRM,DX,DY,DZ) ;MAKE FRAME WITH RESPECT TO VECTOR.
COMMENT .-----------------------------------------------------------.
;NORMALIZE THE COMPONENTS OF THE VECTOR.
SKIPE 1,DX↔FMPR 1,1↔DAC 1,4
SKIPE 2,DY↔FMPR 2,2↔DAC 2,5
SKIPE 3,DZ↔FMPR 3,3
FADR 1,2↔FADR 1,3
SETQ(R,{SQRT↑,1})
;ROTATION AXIS FRAME OF REFERENCE.
SETQ(TMP1,{MKFRAME})↔DAC 1,7↔SKIPN R↔POP3J
LAC 1,DX↔DAC 1,XWC(7)↔FDVR 1,R↔DAC 1,IX(7)↔DAC 1,JY(7)
LAC 2,DY↔DAC 2,YWC(7)↔FDVR 2,R↔DAC 2,IY(7)↔DAC 2,JX(7)
LAC 3,DZ↔DAC 3,ZWC(7)↔FDVR 3,R↔DAC 3,IZ(7)↔SETZM JZ(7)
MOVM 3↔CAMLE[0.999]↔MOVNM JY(7)
CALL(ORTHO2,TMP1)↔CALL(NORM,TMP1)
LAC 1,TMP1
POP3J
DECLARE{R,TMP1}
ENDR MKQFRM;3/6/74(BGB)----------------------------------------------
SUBR(NORM,FRAME) ; NORMALIZE A FRAME MATRIX.
COMMENT .-----------------------------------------------------------.
;ACCUMULATORS:
; 05 06 07 IX IY IZ
; 10 11 12 JX JY JZ
; 13 14 15 KX KY KZ.
SAVAC(15)
MOVS FRAME↔HRRI 5↔BLT 15
; R ← SQRT(A↑2+B↑2+C↑2); A←A/R; B←B/R; C←C/R;
FOR Q IN (5,10,13){
MOVM 1,Q↔CAMG 1,[1.0E-8]↔SETZB 1,Q↔FMPR 1,1
MOVM 1+Q↔CAMG 0,[1.0E-8]↔SETZB 1+Q↔FMPR↔FADR 1,0
MOVM 2+Q↔CAMG 0,[1.0E-8]↔SETZB 2+Q↔FMPR↔FADR 1,0
SKIPE 1↔CAMN 1,[1.0]↔GO .+6↔CALL(SQRT,1)
FDVR Q,1↔FDVR Q+1,1↔FDVR Q+2,1}
;PUT'EM DOWN.
LAC 1,FRAME
MOVSI 5↔HRRI IX(1)↔BLT KZ(1)
GETAC(15)↔POP1J
ENDR NORM;1/14/73----------------------------------------------------
SUBR(ORTHO1,FRAME) ; ORTHOGONIZE AN ORIENTATION MATRIX.
COMMENT .-----------------------------------------------------------.
;IT IS ASSUMED THAT THE ROW VECTORS ARE UNIT VECTORS.
X←←0 ↔ Y←←1 ↔ Z←←2 ;ADDRESS DISPLACEMENTS.
Q←←9 ↔ R←←13 ↔ A←←14 ↔ B←←15 ;ACCUMULATORS.
SAVAC(15)↔SETOM FLG# ;FIRST TIME THRU FLAG.
L0: LAC R,FRAME
MOVSI Q,IX(R)↔BLT Q,KZ ;FIRST NINE ACCUMULATORS.
;DOT EACH ROW VECTOR INTO THE NEXT ROW.
FMPR IX,JX↔FMPR IY,JY↔FMPR IZ,JZ
FADR IX,IY↔FADR IX,IZ
FMPR JX,KX↔FMPR JY,KY↔FMPR JZ,KZ
FADR JX,JY↔FADR JX,JZ
FMPR KX,IX(R)↔FMPR KY,IY(R)↔FMPR KZ,IZ(R)
FADR KX,KY↔FADR KX,KZ
;TAKE ABSOLUTE VALUES AND FIND THE WORST TOTAL COSINE.
MOVMS IX↔MOVMS JX↔MOVMS KX
LAC Q,KX↔FADR KX,JX↔FADR JX,IX↔FADR Q,IX
EXCH Q,JX↔SETZM SIGN#
MOVEI 1,IX(R)↔MOVEI 2,JX(R)↔MOVEI 3,KX(R) ;GET ROW POINTERS.
CAML Q,IX↔GO .+4
EXCH 2,1↔EXCH Q,IX↔SETCMM SIGN ;GET 2 BIGGER THAN 1.
CAML KX,Q↔GO .+4
EXCH 3,2↔EXCH KX,Q↔SETCMM SIGN ;GET 3 BIGGER THAN 2.
CAMG KX,[0.00001]↔GO L1 ;GOOD ENUF FOR GOVERNMENT WORK.
;STRAIGHTEN UP THE WORST VECTOR.
LAC A,Y(1)↔FMPR A,Z(2)
LAC B,Y(2)↔FMPR B,Z(1)↔FSBR A,B↔DAC A,X(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM X(3)
LAC A,X(2)↔FMPR A,Z(1)
LAC B,X(1)↔FMPR B,Z(2)↔FSBR A,B↔DAC A,Y(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM Y(3)
LAC A,X(1)↔FMPR A,Y(2)
LAC B,X(2)↔FMPR B,Y(1)↔FSBR A,B↔DAC A,Z(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM Z(3)
SKIPE SIGN↔GO[MOVNS X(3)↔MOVNS Y(3)↔MOVNS Z(3)↔GO .+1]
SKIPN FLG↔GO L1↔SETZM FLG↔GO L0
L1: GETAC(15)↔POP1J
ENDR ORTHO1;1/14/73(BGB)---------------------------------------------
SUBR(ORTHO2,QFRAME)
COMMENT .-----------------------------------------------------------.
; ACCEPT I; K' ← I CROSS J; J' ← K CROSS I;
LAC 1,QFRAME
SETZM KX(1)↔SETZM KY(1)↔SETZM KZ(1)
MOVS QFRAME↔HRRI 1↔BLT 9
LAC 12,4↔LAC 13,5↔LAC 14,6 ;SAVE J VECTOR.
;VECTOR-K ← VECTOR-I CROSS VECTOR-J.
LAC 2↔FMP 6↔DAC 7
LAC 5↔FMP 3↔FSB 7,
LAC 4↔FMP 3↔DAC 8
LAC 1↔FMP 6↔FSB 8,
LAC 1↔FMP 5↔DAC 9
LAC 4↔FMP 2↔FSB 9,
;VECTOR-J ← VECTOR-K CROSS VECTOR-I.
LAC 8↔FMP 3↔DAC 4
LAC 2↔FMP 9↔FSB 4,
LAC 1↔FMP 9↔DAC 5
LAC 7↔FMP 3↔FSB 5,
LAC 7↔FMP 2↔DAC 6
LAC 1↔FMP 8↔FSB 6,
LAC 15,QFRAME↔MOVSI 1
HRRI IX(15)↔BLT KZ(15)
LAC 1,QFRAME↔POP1J
ENDR ORTHO2;3/30/73(BGB)---------------------------------------------
SUBR(DETERM,FRAME)
COMMENT .-----------------------------------------------------------.
MOVS FRAME↔HRRI 1↔BLT 9
LAC 5↔FMP 9↔LAC 12,
LAC 6↔FMP 8↔FSB 12,↔FMP 1,12
LAC 6↔FMP 7↔LAC 12,
LAC 4↔FMP 9↔FSB 12,↔FMP 2,12↔FAD 1,2
LAC 4↔FMP 8↔LAC 12,
LAC 5↔FMP 7↔FSB 12,↔FMP 3,12↔FAD 1,3↔POP1J
ENDR DETERM;4/1/73(BGB)----------------------------------------------
SUBR(ANGL3V,VERT1,VERT2,VERT3) ;ANGLE TRI-VERTEX.
COMMENT .-----------------------------------------------------------.
;ANGLE V1,V2,V3 CCW; RETURNS VALUE 0 TO 2π.
V1 ←← 13
V2 ←← 14
V3 ←← 15
;DETERMINE WHETHER THE ANGLE IS MORE OR LESS THAN PI.
LAC V1,VERT1↔MOVSI XWC(V1)↔HRRI 1↔BLT 3
LAC V2,VERT2↔MOVSI XWC(V2)↔HRRI 4↔BLT 6
LAC V3,VERT3↔MOVSI XWC(V3)↔HRRI 7↔BLT 9
FSBR 1,4↔FSBR 2,5↔FSBR 3,6 ;V1' ← (V1-V2).
FSBR 7,4↔FSBR 8,5↔FSBR 9,6 ;V3' ← (V3-V2).
LAC 2↔FMP 9↔LAC 4,↔LAC 3↔FMP 8↔FSB 4, ;V2' ← (V1 X V3).
LAC 3↔FMP 7↔LAC 5,↔LAC 1↔FMP 9↔FSB 5,
LAC 1↔FMP 8↔LAC 6,↔LAC 2↔FMP 7↔FSB 6,
FADR 1,4↔FADR 2,5↔FADR 3,6 ;V1" ← (V1'+V2').
FADR 7,4↔FADR 8,5↔FADR 9,6 ;V3" ← (V3'+V2').
;DETERM NGEATIVE INDICATES CCW ORDER, 0 TO π.
;DETERM POSITIVE INDICATES CW ORDER, π T0 2π.
CALL({DETERM+3},0)
SKIPL 1↔SKIPA 1,PI↔SETZ 1,↔PUSH P,1
;COSINE LAW.
CALL(DISTANCE,V2,V1)↔PUSH P,1
CALL(DISTANCE,V2,V3)↔PUSH P,1
CALL(DISTANCE,V1,V3)
FMPR 1,1↔MOVNS 1
POP P,2↔LAC 2↔FMPR 2,2
POP P,3↔FMP 3↔FMPR 3,3
FSC 1↔FADR 1,2↔FADR 1,3
FDVR 1,0↔CALL(ACOS,1)
POP P,0↔FADR 1,0↔POP3J
ENDR ANGL3V;4/1/73(BGB)----------------------------------------------
SUBR(DISTAN,V1,V2) ;DISTANCE BETWEEN TWO VERTICES.
COMMENT .-----------------------------------------------------------.
LAC 1,V1↔LAC 2,V2
LAC XWC(1)↔FSBR XWC(2)↔FMPR↔DAC 3
LAC YWC(1)↔FSBR YWC(2)↔FMPR↔FADRM 3
LAC ZWC(1)↔FSBR ZWC(2)↔FMPR↔FADR 3
CALL(SQRT,0)↔POP2J
ENDR DISTAN;2/10/73(BGB)---------------------------------------------
END
EUCLID.FAI - EOF.